home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / cl-nd-cl.lha / clue-and-clio-advice
Lisp/Scheme  |  1992-04-07  |  11KB  |  332 lines
  1. Here are some things you can do to sutup clue and clio:
  2.  
  3.     CLUE (Common Lisp User-Interface Environment) is from TI,
  4.     and extends CLX to provide a simple, object-oriented toolkit
  5.     (like Xt) library that uses CLOS. Provides basic window
  6.     classes, some stream I/O facilities, and a few other
  7.     utilities. Still pretty low level (it's a toolkit, not widget library).
  8.     Available free by anonymous ftp from csc.ti.com:pub/clue.tar.Z
  9.     Written by Kerry Kimbrough. Send bug reports to
  10.     clue-bugs@dsg.csc.ti.com. The users group mailing list is
  11.     clue-review@dsg.csc.ti.com (send mail to
  12.     clue-review-request@dsg.csc.ti.com to be added to the list). 
  13.  
  14.     CLIO (Common Lisp Interactive Objects) is a GUI from the
  15.     people who created CLUE. It provides a set of CLOS classes
  16.     that represent the standard components of an object-oriented
  17.     user interface -- such as text, menus, buttons, scroller, and dialogs.
  18.     It is included as part of the CLUE distribution, along with
  19.     some packages that use it, both sample and real.
  20.  
  21. 1) get clue.tar.Z, and untar it, so that its root directory is in
  22.    the directory that contains pcl and clx.
  23.  
  24. 2) rename all the .l files to .lisp:
  25.  
  26.    foreach i (*/*.l */*/*.l)
  27.    mv $i $i.lisp
  28.    end
  29.  
  30. 3) create the following files:
  31.  
  32. ----------- systems/clue.lisp --------------
  33.   ;;; -*- Mode: Lisp; Package: DSYS; Base: 10; Syntax: Common-Lisp -*-
  34.  
  35. (in-package "DSYS")
  36.  
  37. (set-system-source-file 'clue (subfile '("clue" "clue") :name "sysdef"))
  38.  
  39. ;(pushnew 'clue *auto-load-systems*)
  40. ----------- systems/clio.lisp --------------
  41. ;;; -*- Mode: Lisp; Package: DSYS; Base: 10; Syntax: Common-Lisp -*-
  42.  
  43. (in-package "DSYS")
  44.  
  45. (set-system-source-file 'clio (subfile '("clue" "clio") :name "sysdef"))
  46.  
  47. ;(pushnew 'clio *auto-load-systems*)
  48. ----------- systems/clio-examples.lisp --------------
  49. ;;; -*- Mode: Lisp; Package: DSYS; Base: 10; Syntax: Common-Lisp -*-
  50.  
  51. (in-package "DSYS")
  52.  
  53. (set-system-source-file 'clio-examples
  54.             (subfile '("clue" "clio" "examples") :name "sysdef"))
  55.  
  56. ;(pushnew 'clio-examples *auto-load-systems*)
  57. ----------- clue/clue/sysdef.lisp --------------
  58. ;;; -*- Mode: Lisp; Package: DSYS; Base: 10; Syntax: Common-Lisp -*-
  59.  
  60. (in-package "DSYS")
  61.  
  62. (defsystem clue
  63.     (:pretty-name "CLUE")
  64.   (:module common-lisp common-lisp (:type :system))
  65.   (:module clx clx (:type :system))
  66.   (:parallel
  67.    common-lisp
  68.    clx
  69.    (:forms :compile 
  70.        (progn
  71.          (setq *compile-system-proclamation*
  72.            '(optimize (speed 3) (safety 0) #+lucid (compilation-speed 3)))
  73.          (proclaim *compile-system-proclamation*)
  74.          #+akcl (setq compiler::*compile-ordinaries* t)))
  75.    (:parallel
  76.     "clue"        ;; Define packages
  77.     (:load "precom")
  78.     ;;"clx-patch"    ;; Modify xlib:create-window
  79.     ;;"window-doc"    ;; pointer documentation window support
  80.     "event-parse"    ;; Utilities for event translation
  81.     "defcontact"    ;; CLOS extension for resources and type conversion
  82.     "intrinsics"    ;; The "guts"
  83.     "caches"        ;; Support for gcontext, pixmap, cursor cacheing
  84.     "resource"        ;; Resource and type conversion
  85.     "gray"        ;; Gray stipple patterns
  86.     "cursor"        ;; Standard cursor names
  87.     "events"        ;; Event handling
  88.     "virtual"        ;; Support for windowless contacts
  89.     "shells"        ;; Support for top-level window/session mgr interaction
  90.     "root-gmgmt"    ;; Geometry management methods for root contacts
  91.     ;;"stream"        ;; interactive-stream (non-portable!!)
  92.     "package"        ;; External cluei symbols exported from clue
  93.     "menu"              ;; example
  94.     (:compile "precom")
  95.     )))
  96. ----------- clue/clio/sysdef.lisp --------------
  97. ;;; -*- Mode: Lisp; Package: DSYS; Base: 10; Syntax: Common-Lisp -*-
  98.  
  99. (in-package "DSYS")
  100.  
  101. (defsystem clio
  102.     (:pretty-name "Common Lisp Interactive Objects")
  103.   (:module clue clue (:type :system))
  104.   (:parallel
  105.    clue
  106.    (:parallel
  107.     (:forms :compile 
  108.         (progn
  109.           (setq *compile-system-proclamation*
  110.             '(optimize (speed 3) (safety 0) #+lucid (compilation-speed 3)))
  111.           (proclaim *compile-system-proclamation*)
  112.           #+akcl (setq compiler::*compile-ordinaries* t)))
  113.     "clio"
  114.     "ol-defs"
  115.     "utility"
  116.     "core-mixins"
  117.     "gravity"
  118.     "buffer"
  119.     "text-command"
  120.     "display-text"
  121.     "ol-images"
  122.     "buttons"
  123.     "confirm"
  124.     "scroller"
  125.     "table"
  126.     "choices"
  127.     "form"
  128.     "menu"
  129.     "psheet"
  130.     "command"
  131.     "edit-text"
  132.     "slider"
  133.     "scroll-frame"
  134.     "mchoices"
  135.     "dlog-button"
  136.     "display-imag"
  137.     )))
  138. ----------- clue/clio/examples/sysdef.lisp --------------
  139. ;;; -*- Mode: Lisp; Package: DSYS; Base: 10; Syntax: Common-Lisp -*-
  140.  
  141. (in-package "DSYS")
  142.  
  143. (defsystem clio-examples
  144.     (:pretty-name "CLIO Example Programs")
  145.   (:module clio clio (:type :system))
  146.   (:parallel
  147.    clio
  148.    (:parallel
  149.     (:forms :compile
  150.         (progn
  151.           (setq *compile-system-proclamation*
  152.             '(optimize (speed 3) (safety 0) #+lucid (compilation-speed 3)))
  153.           (proclaim *compile-system-proclamation*)
  154.           #+akcl (setq compiler::*compile-ordinaries* t)))
  155.     "package"
  156.     (:load "precom")
  157.     "cmd-frame"
  158.     "sketchpad"
  159.     "sketch"
  160.     (:compile "precom"))))
  161. ------------------------------------------------------------
  162.  
  163. 4) Add these lines from defsystem.lisp to the top of clue.lisp
  164.    (after the in-package form).
  165.  
  166. ;; Ensure VALUES is a legal declaration
  167. (proclaim '(declaration values))
  168.  
  169. ;; Ensure *features* knows about CLOS and PCL
  170. (when (find-package 'pcl)
  171.   (pushnew :pcl  *features*)
  172.   (pushnew :clos *features*))
  173.  
  174. (when (find-package 'clos)
  175.   (pushnew :clos *features*))
  176.  
  177. ;; Ensure *features* knows about the Common Lisp Error Handler
  178. (when (find-package 'conditions)
  179.   (pushnew :cleh *features*))
  180.  
  181.  
  182. *** Note: The following several changes are because slot-value access
  183.   within defmethods specialized on a structure-class are very efficient 
  184.   (in March 92 PCL, at least).
  185.  
  186. 5) If you want, 
  187.     a) add (:metaclass structure-class) to the definition of
  188.        event in clue/clue/events.lisp
  189.     b) change allocate-event to be
  190.  
  191. (defun allocate-event ()
  192.   ;; Get an event structure, initializing all slots to NIL
  193.   (initialize-event (or (pop *event-cache*)
  194.             (make-instance 'event))))
  195.  
  196.     c) and change initialize-event to begin like this:
  197.  
  198. (defmethod initialize-event ((event event))
  199.   (with-slots (key display contact character keysym plist code state time 
  200.            event-window root drawable window child parent root-x root-y x y
  201.            width height border-width override-redirect-p same-screen-p
  202.            configure-p hint-p kind mode keymap focus-p count major minor
  203.            above-sibling place atom selection requestor target property
  204.            colormap new-p installed-p format type data name send-event-p)
  205.     (the event event)
  206. ...))
  207.  
  208.  
  209. 6)  Split up process-next-event so that the modification of the event structure
  210.     happens within a defmethod:
  211.  
  212. (defun process-next-event (display &optional timeout (update-state-p t))
  213.   "Process one event. Call UPDATE-STATE iff UPDATE-STATE-P is true. "
  214.   (declare (type display display)
  215.        (type (or null number) timeout)
  216.        (type boolean update-state-p)
  217.        (values boolean))
  218.  
  219.   ;; Ensure consistent contact states
  220.   (when update-state-p (update-state display))
  221.  
  222.   (let* (;; Process any timers that have expired
  223.      (interval-until-next-timer  (execute-timers display))
  224.      ;; Compute true timeout
  225.      (wait-for-timer-p (when (or (null timeout)
  226.                      (and interval-until-next-timer
  227.                       (< interval-until-next-timer timeout)))
  228.                  interval-until-next-timer))
  229.      (event (allocate-event))
  230.      (result nil))
  231.  
  232.     (setf (slot-value (the event event) 'display) display)
  233.     (setf result
  234.       (or (set-event-and-dispatch event display (or wait-for-timer-p timeout))
  235.           ;; No event read -- 
  236.           ;;   return true (i.e. no timeout) if we now have a timer ready
  237.           (when wait-for-timer-p t)))
  238.     
  239.     ;; We could add an unwind protect to ensure that the event is always
  240.     ;; deallocated (process-next-event is sometimes thrown out of).
  241.     ;; However, we judge that an unwind-protect all the time is more
  242.     ;; expensive than garbage collecting an event structure some of the
  243.     ;; time.
  244.     (deallocate-event event)
  245.     
  246.     result))
  247.  
  248. (defmethod set-event-and-dispatch ((event event) display timeout)
  249.   (macrolet ((set-event (&rest parameters)
  250.            `(progn ,@(mapcar #'(lambda (parm)
  251.                      `(setf (slot-value event ',parm) ,parm))
  252.                      parameters)))
  253.          (dispatch (contact)
  254.            `(progn
  255.           (dispatch-event event event-key send-event-p sequence ,contact)
  256.           t)))
  257.     ;; Wait for an event, copy info into the EVENT structure then call DISPATCH-EVENT
  258.     (xlib:event-cond (display :timeout timeout
  259.                   :force-output-p t
  260.                   :discard-p t)
  261.       ((:key-press :key-release :button-press :button-release)
  262.        (code time root window child root-x root-y x y
  263.          state same-screen-p event-key sequence send-event-p) t
  264.        (set-event code time root window child root-x root-y x y
  265.           state same-screen-p)
  266.        (dispatch window))
  267. >>> Put the rest of the code here. <<<
  268.       (:mapping-notify            ; Special case
  269.        (request start count) t
  270.        (mapping-notify display request start count)
  271.        (when (eq request :modifier)    ; Update the modifier mapping translate table
  272.      (get-display-modifier-translate display :update))
  273.        t))))
  274.  
  275.  
  276. 7)  If you want, you can go through the rest of CLUE and CLIO changing defuns to 
  277.     defmethods when it is clear what the classes of the required arguments must be,
  278.     so that slot-value calls will be faster.
  279.  
  280.  
  281. 8)  I made this change to clue/clue/intrinsics.lisp (but I can't remember why):
  282. Old:
  283.           ;; and after-effect function returned...
  284. !         (functionp after-effect)
  285.           
  286.           ;; and not in the middle of a batch of layout changes...
  287. --- 1641,1650 ----
  288. New:
  289.           ;; and after-effect function returned...
  290. !         (and (functionp after-effect)
  291. !              (or (not (symbolp after-effect)) (fboundp after-effect)))
  292.           
  293. 9)  In resource.lisp, you can make this change:
  294. Old:
  295. ! #+explorer
  296.   (defgeneric convert (contact value type)
  297.     ;; This :argument-precedence-order makes things more efficient.
  298.     (:argument-precedence-order type contact value))
  299. --- 178,186 ----
  300. New:
  301. ! #+(or explorer pcl)
  302.   (defgeneric convert (contact value type)
  303.     ;; This :argument-precedence-order makes things more efficient.
  304.     (:argument-precedence-order type contact value))
  305.  
  306. 10)  In clue/clio/buffer.lisp there is a definition of defstruct*.
  307.      You can change it to be:
  308.  
  309. ;;; PCL can't (portably) specialize methods on structure classes unless
  310. ;;; they are defined with defclass.  Use defstruct* to define such structures.
  311. ;;; (Note that the :metaclass option is given to defclass.)
  312. (defmacro defstruct* (name &rest slots)
  313.   #-pcl
  314.   `(defstruct ,name ,@slots)
  315.   
  316.   #+pcl
  317.   (flet ((translate-slot (slot &optional initform &key (type t))
  318.        `(,slot
  319.          :initform ,initform
  320.          :type ,type
  321.          :initarg ,(intern (string slot) (find-package :keyword))
  322.          :accessor ,(intern (format nil "~a-~a" name slot)))))
  323.     (let ((pred (intern (format nil "~a-P" name))))
  324.       `(progn
  325.     (defclass ,name ()
  326.       ,(mapcar #'(lambda (x) (apply #'translate-slot x)) slots)
  327.       (:metaclass structure-class))
  328.     (defmethod ,pred ((z t))  nil)
  329.     (defmethod ,pred ((z ,name)) t)
  330.     (defun ,(intern (format nil "MAKE-~a" name)) (&rest args)
  331.       (apply #'make-instance ',name args))))))
  332.